(in-package :gcode)

(defun test ()
  (g-program
   (:m3)

   (with-tool (*test-tool*)
     (goto-abs :x 10 :y 10)
     #+nil(rectangle-mill 10 10 :depth 10)
     (rectangle-outline 10 10)
     (goto-abs :x 15 :y 10)
     (circle-mill 5))
   
   #+nil
   (rectangle-outline 10 10 :depth 10)
   #+nil
   (with-tool-down ()
     (goto-rel :x -0.5 :y -0.5)
     (rectangle 10 10))

   (home)
   
   ))

(defun test-transform ()
  (g-program
   (:m3)
   (with-tool (*test-tool*)
     (with-transform ((translation-matrix 10 10))
       (with-transform ((scaling-matrix 2))
	 (goto-abs-transform :x 0 :y 0)
	 (with-tool-down (8)
	   (mill-abs-transform :x 0 :y 10)
	   (mill-abs-transform :x 10 :y 10)
	   (mill-abs-transform :x 10 :y 0)
	   (mill-abs-transform :x 0 :y 0)))))))


(defun test-round-edge2 ()
  (g-program
   (spindle-on)
   (with-tool (*test-tool*)
       (mill-rounded-edge 10 10 20 10 5 3 10 :overlap 4)
       #+nil(mill-rounded-edge 20 10 20 20 5 3))))

(defun test-rectangle ()
  (with-program ("rectangle")
    (spindle-on)
    (with-tool (*test-tool*)
      (goto-abs :x 10 :y 10)
      (with-tool-down ()
	(rectangle 10 10)))))


(defun test-rectangle-transform ()
  (with-program ("rectangle")
    (spindle-on)
    (with-tool (*test-tool*)
      (with-transform ((translation-matrix 20 20))
	(with-transform ((scaling-matrix 10))
	  (goto-abs :x 10 :y 10)
	  (with-tool-down ()
	    (rectangle 10 10)))))))

(defun test-circle ()
  (with-program ("circle")
    (spindle-on)
    (with-tool (*test-tool*)
      (with-tool-down ()
	(goto-abs :x 50 :y 50)
	(circle 40)))))

(defun test-circle-fill ()
  (with-program ("circle-fill")
    (spindle-on)
    (with-tool (*test-tool*)
      (with-tool-down ()
	(goto-abs :x 50 :y 50)
	(circle-fill 40 4)))))

(defun test-move-1 ()
  (with-program ("move-test")
    (spindle-on)
    (with-tool (*test-tool*)
      (with-tool-down ()
	(dotimes (i 3)
	  (mill-r)
	  (mill-bridge-r++))))))

(defun test-move-2 ()
  (with-program ("move-test")
    (with-tool (*test-tool*)
      (tool-up)
      (home)
      (tool-down :depth *fly-height*)
      (with-tool-down ()
	(dotimes (i 3)
	  (mill-bridge-r++)
	  (mill-u)
	  (mill-r--)
	  (mill-d)
	  (mill-r))))))

(defun test-round-1 ()
  (with-program ("round-test")
    (with-tool (*test-tool*)
      (tool-up)
      (home)
      (tool-down :depth *fly-height*)
      (with-tool-down ()
	(dotimes (i 3)
	  (mill-bridge-r++)
	  (s-mill-round-u)
	  (mill-r--)
	  (s-mill-round-d)
	  (mill-r))))))


(defun test-file ()
  (with-program ("file-tool")
    (with-tool (*cube-tool*)
      (tool-up)
      (home)
      (load-file "/Users/manuel/mill.plt"))))
  


(defun test-moves ()
  (g-program
   (spindle-on)
   (let ((*cut-steps* nil)
	 (*round-steps* nil))
     (with-tool (*test-tool*)
       (goto-abs :x 10 :y 10)
       (with-tool-down ()
	 (mill-r++)
	 (s-mill-round-u)
	 (mill-r--)
	 (s-mill-round-d)
	 (mill-r++)
	 (s-mill-round-u)
	 (mill-r--)
	 (s-mill-round-d)
	 (mill-r++)
	 (s-mill-round-u)
	 (mill-r--)
	 (s-mill-round-d))
	 
       (nreverse *cut-steps*)
       (nreverse *round-steps*)))))

(defun test-face-top ()
  (g-program
   (spindle-on)
   (with-tool (*test-tool*)
     (with-transform ((translation-matrix 20 20))
       (goto-abs-transform :x 18.5 :y 8.5)
       (with-tool-down (5)
	 (mill-abs-transform :x 31.5 :y 8.5)
	 (mill-abs-transform :x 31.5 :y 18.5))
       (mill-rounded-edge 31.5 18.5 41.5 18.5 5 3 3 :overlap 4)
       (with-tool-down (5)
	 (mill-abs-transform :x 41.5 :y 31.5))
       (mill-rounded-edge 41.5 31.5 31.5 31.5 5 3 3 :overlap 4)
       (with-tool-down (5)
	 (mill-abs-transform :x 31.5 :y 41.5)
	 (mill-abs-transform :x 18.5 :y 41.5)
	 (mill-abs-transform :x 18.5 :y 31.5))
       (mill-rounded-edge 18.5 31.5 8.5 31.5 5 3 3 :overlap 4)
       (with-tool-down (5)
	 (mill-abs-transform :x 8.5 :y 18.5))
       (mill-rounded-edge 8.5 18.5 18.5 18.5 5 3 3 :overlap 4)
       (with-tool-down (5)
	 (mill-abs-transform :x 18.5 :y 8.5))))))

(defun test-face-top-rel ()
  (g-program
   (spindle-on)
     (let ((*current-x* 10)
	   (*current-y* 5))
   (with-tool (*test-tool*)
       (goto-abs :x *current-x* :y *current-y* :z 2)
       (with-tool-down (4)
	 (mill-r++)
	 (mill-u))
       (mill-round-r)
       (with-tool-down (4)
	 (mill-u++))
       (mill-round-l)
       (with-tool-down (4)
	 (mill-u)
	 (mill-l++)
	 (mill-d))
       (mill-round-l)
       (with-tool-down (4)
	 (mill-d++))
       (mill-round-r)
       (with-tool-down (4)
	 (mill-d))))))

(defun test-face-bottom-rel ()
  (g-program
   (spindle-on)
   (let ((*current-x* 30)
	 (*current-y* 5))
     (with-tool (*test-tool*)
       (goto-abs :x *current-x* :y *current-y* :z 2)
       (with-tool-down (4)
	 (mill-r)
	 (mill-r++)
	 (mill-u))
       (mill-round-r)
       (with-tool-down (4)
	 (mill-u++))
       (mill-round-l)
       (with-tool-down (4)
	 (mill-u)
	 (mill-l)
	 (mill-l++)
	 (mill-d++)
	 (mill-r)
	 (mill-d--)
	 (mill-l)
	 (mill-d++))))))


(defun cut-test ()
  (g-program
   (spindle-on)
   (let ((*current-x* 50)
	 (*current-y* 5)
	 (*round-steps* nil)
	 (*cut-steps* nil))
     
     (with-tool (*test-tool*)
       (goto-abs :x *current-x* :y *current-y* :z 2)
       (with-tool-down (*step-width*)
	 (mill-bridge-r++)
	 (mill-bridge-r++)
	 (mill-bridge-u++)
	 (mill-bridge-u++)
	 (mill-bridge-l++)
	 (mill-bridge-l++)
	 (mill-bridge-d++)
	 (mill-bridge-d++)
	 (mill-abs :z 0.5)
	 (nreverse *cut-steps*))))))

	 

(defun test-round-edge ()
  (g-program
   (:m3)
   (with-tool (*test-tool*)
     (goto-abs :x 10 :y 8.5)
     (with-tool-down (8)
       (mill-abs :x 20 :y 8.5))

     (loop for j from 20 downto 10 by 1
	  collect (mill-abs :z 1)
	collect (goto-abs :x j :y 10)
	collect (mill-abs :z 0 :y 10)
	collect  (loop for i from 0 to 90 by 4
		    collect (mill-abs :y (- 10 (* 1.5 (sin (deg-to-radians i))))
				      :z (- (* 1.5 (cos (deg-to-radians i))) 1.5)))))))